{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}

module Vote.Api where

import Control.Lens ((^.))
import Data.Aeson.Text (encodeToLazyText)
import Data.Function (id)
import Data.OpenApi (OpenApi)
import Data.Pool (withResource)
import Data.String (String)
import Data.Tuple.All (Sel1 (..))
import Data.Tuple.Curry (Curry (..))
import Effectful (Eff, IOE)
import Effectful.Error.Dynamic (throwError)
import Effectful.FileSystem (FileSystem)
import Effectful.Reader.Dynamic (Reader, asks)
import Network.HTTP.Types (StdMethod (..), ok200)
import Network.Mime (MimeType)
import Opaleye (Delete (..), Insert (..), Update (..), countRows, limit, maybeToNullable, offset, rCount, rReturning, runDelete, runInsert, runSelect, runUpdate, selectTable, sqlInt4, sqlInt8, sqlStrictText, sqlUTCTime, toNullable, updateEasy, where_, (.==))
import Protolude hiding (Handler, Reader, Rep, ask, asks, from, throwError)
import Vote.Internal.App (AppEnv, appEnvPool)
import Vote.Internal.Effect (Logging, catchRep)
import Vote.Internal.Entity
import Vote.Internal.Model (SceneType (SceneTypeMark))
import WebGear.OpenApi (toOpenApi)
import WebGear.Server hiding (null, ok200)
import WebGear.Swagger.UI (swaggerUI)

type App = Eff (Logging : FileSystem : Reader AppEnv : IOE : '[])

allRoutes ::
  ( StdHandler h App,
    Gets
      h
      '[ Body JSON Page,
         PathVar "id" Int64,
         Body JSON SceneAdd,
         Body JSON SceneUpd,
         Body JSON ActorAdd,
         Body JSON ActorUpd,
         Body JSON VoterAdd,
         Body JSON VoterUpd,
         Body JSON ActionAdd
       ],
    Sets
      h
      [ RequiredResponseHeader "Content-Type" Text,
        ResponseHeader Required "Content-Type" MimeType,
        UnknownContentBody,
        Body HTML ByteString,
        Body PlainText String,
        Body JSON OpenApi,
        Body JSON (Rep ()),
        Body JSON (Rep Int64),
        Body JSON (Rep Text),
        Body JSON (Rep (PageD [SceneGet])),
        Body JSON (Rep (PageD [Actor])),
        Body JSON (Rep (PageD [Voter])),
        Body JSON (Rep (Maybe SceneGet)),
        Body JSON (Rep (Maybe Actor)),
        Body JSON (Rep (Maybe Voter)),
        Body JSON (Rep SceneGet),
        Body JSON (Rep Actor),
        Body JSON (Rep Voter),
        Body JSON (Rep ())
      ]
  ) =>
  RequestHandler h '[]
allRoutes =
  routes
    <+> [match| /openapi |] (swaggerUI $ toOpenApi @App @(With Request '[]) @Response routes)

-- <+> method GET assets

-- assets =
--   let settings = (defaultWebAppSettings "ui"){ssIndices = unsafeToPiece <$> ["index.html", "index.htm"]}
--    in serveStatic settings

routes ::
  ( StdHandler h App,
    Gets
      h
      '[ Body JSON Page,
         PathVar "id" Int64,
         Body JSON SceneAdd,
         Body JSON SceneUpd,
         Body JSON ActorAdd,
         Body JSON ActorUpd,
         Body JSON VoterAdd,
         Body JSON VoterUpd,
         Body JSON ActionAdd
       ],
    Sets
      h
      [ RequiredResponseHeader "Content-Type" Text,
        Body PlainText String,
        Body JSON (Rep ()),
        Body JSON (Rep Int64),
        Body JSON (Rep Text),
        Body JSON (Rep (PageD [SceneGet])),
        Body JSON (Rep (PageD [Actor])),
        Body JSON (Rep (PageD [Voter])),
        Body JSON (Rep (Maybe SceneGet)),
        Body JSON (Rep (Maybe Actor)),
        Body JSON (Rep (Maybe Voter)),
        Body JSON (Rep SceneGet),
        Body JSON (Rep Actor),
        Body JSON (Rep Voter),
        Body JSON (Rep ())
      ]
  ) =>
  RequestHandler h '[]
routes =
  zeroArrow
    <+> [route| GET /api/hello |] hello
    <+> [route| GET /api/doc |] doc
    <+> [route| POST /api/scene/list |] sceneList
    <+> [route| GET /api/scene/get/id:Int64 |] sceneGet
    <+> [route| POST /api/scene/add |] sceneAdd
    <+> [route| POST /api/scene/upd |] sceneUpd
    <+> [route| POST /api/scene/del/id:Int64 |] sceneDel
    <+> [route| GET /api/actor/list |] actorList
    <+> [route| GET /api/actor/get/id:Int64 |] actorGet
    <+> [route| POST /api/actor/add |] actorAdd
    <+> [route| POST /api/actor/upd |] actorUpd
    <+> [route| POST /api/actor/del/id:Int64 |] actorDel
    <+> [route| GET /api/voter/list |] voterList
    <+> [route| GET /api/voter/get/id:Int64 |] voterGet
    <+> [route| POST /api/voter/add |] voterAdd
    <+> [route| POST /api/voter/upd |] voterUpd
    <+> [route| POST /api/voter/del/id:Int64 |] voterDel
    <+> [route| POST /api/action |] actionAdd

errorHandler ::
  ( Show e,
    StdHandler h m,
    Sets h [RequiredResponseHeader "Content-Type" Text, Body JSON (Rep ())]
  ) =>
  h (Request `With` ts, e) Response
errorHandler = proc (_, err) -> respondA ok200 JSON -< (repErr 1 (show err) :: Rep ())

hello ::
  ( StdHandler h App,
    Sets h [RequiredResponseHeader "Content-Type" Text, Body PlainText String]
  ) =>
  RequestHandler h ts
hello = proc _ ->
  respondA ok200 PlainText -< "Hello, World!" :: Text

doc ::
  ( StdHandler h App,
    Sets h [RequiredResponseHeader "Content-Type" Text, Body PlainText Text]
  ) =>
  RequestHandler h ts
doc = proc _ ->
  respondA ok200 PlainText -< encodeToLazyText $ toOpenApi @App @(With Request '[]) @Response routes

sceneList ::
  ( StdHandler h App,
    Gets h '[Body JSON Page],
    Sets h [RequiredResponseHeader "Content-Type" Text, Body JSON (Rep (PageD [SceneGet])), Body JSON (Rep ())]
  ) =>
  RequestHandler h ts
sceneList =
  requestBody @Page JSON errorHandler $
    proc request -> do
      let page = pick @(Body JSON Page) $ from request
      pageD <-
        arrM
          ( \page -> catchRep $ do
              pool <- asks (^. appEnvPool)
              (rs, cs) <- liftIO . withResource pool $
                \conn -> do
                  rs <- runSelect conn . limit (fromIntegral $ page ^. pageSize) . offset (fromIntegral $ (page ^. pageIndex - 1) * (page ^. pageSize)) $ selectTable sceneTable
                  cs <- runSelect conn . countRows $ selectTable sceneTable
                  return (rs, cs)
              return . rep . fillPage page (maybe 0 fromIntegral (listToMaybe (cs :: [Int64]))) $ uncurryN SceneGet <$> rs
          )
          -<
            page
      respondA ok200 JSON -< pageD

sceneGet ::
  ( StdHandler h App,
    HaveTraits '[PathVar "id" Int64] ts,
    Sets h [RequiredResponseHeader "Content-Type" Text, Body JSON (Rep (Maybe SceneGet))]
  ) =>
  RequestHandler h ts
sceneGet =
  proc request -> do
    let tid = pick @(PathVar "id" Int64) $ from request
    (mScene :: Maybe SceneGet) <-
      arrM
        ( \tid -> do
            pool <- asks (^. appEnvPool)
            rs <- liftIO . withResource pool $
              \conn -> runSelect conn $ do
                r <- selectTable sceneTable
                where_ $ sel1 r .== sqlInt8 tid
                pure r
            pure . listToMaybe $ uncurryN SceneGet <$> rs
        )
        -<
          tid
    respondA ok200 JSON -< rep mScene

sceneAdd ::
  ( StdHandler h App,
    Gets h '[Body JSON SceneAdd],
    Sets h [RequiredResponseHeader "Content-Type" Text, Body JSON (Rep Int64), Body JSON (Rep ())]
  ) =>
  RequestHandler h ts
sceneAdd =
  requestBody @SceneAdd JSON errorHandler $
    proc request -> do
      let sceneToAdd = pick @(Body JSON SceneAdd) $ from request
      tid <-
        arrM
          ( \sceneToAdd -> catchRep $ do
              let markDeno = case _sceneAddTypeEnum sceneToAdd of
                    SceneTypeMark -> fromMaybe 100 (_sceneAddMarkDeno sceneToAdd)
                    _ -> 1
              when (markDeno < 1) . throwError $ Err 1 "mark deno must be greater than zero"
              pool <- asks (^. appEnvPool)
              ids <- liftIO . withResource pool $ \conn -> do
                runInsert
                  conn
                  Insert
                    { iTable = sceneTable,
                      iRows =
                        [ ( Nothing,
                            sqlStrictText . show $ _sceneAddTypeEnum sceneToAdd,
                            sqlStrictText (_sceneAddInfo sceneToAdd),
                            maybeToNullable $ sqlUTCTime <$> _sceneAddTimeOpen sceneToAdd,
                            maybeToNullable $ sqlUTCTime <$> _sceneAddTimeShut sceneToAdd,
                            sqlInt4 markDeno
                          )
                        ],
                      iReturning = rReturning sel1,
                      iOnConflict = Nothing
                    }
              maybe (throwError $ Err 1 "insert failure") (return . rep) (listToMaybe ids)
          )
          -<
            sceneToAdd
      respondA ok200 JSON -< (tid :: Rep Int64)

sceneUpd ::
  ( StdHandler h App,
    Gets h '[Body JSON SceneUpd],
    Sets h [RequiredResponseHeader "Content-Type" Text, Body JSON (Rep SceneGet), Body JSON (Rep ())]
  ) =>
  RequestHandler h ts
sceneUpd =
  requestBody @SceneUpd JSON errorHandler $
    proc request -> do
      let sceneToUpd = pick @(Body JSON SceneUpd) $ from request
      ru <-
        arrM
          ( \sceneToUpd -> catchRep $ do
              pool <- asks (^. appEnvPool)
              ru <- liftIO . withResource pool $ \conn -> do
                runUpdate
                  conn
                  Update
                    { uTable = sceneTable,
                      uUpdateWith =
                        updateEasy
                          ( \(id_, type_, info, timeOpen, timeShut, markDeno) ->
                              ( id_,
                                type_,
                                maybe info sqlStrictText (_sceneUpdInfo sceneToUpd),
                                maybe timeOpen (toNullable . sqlUTCTime) (_sceneUpdTimeOpen sceneToUpd),
                                maybe timeShut (toNullable . sqlUTCTime) (_sceneUpdTimeShut sceneToUpd),
                                markDeno
                              )
                          ),
                      uWhere = (.== sqlInt8 (_sceneUpdId sceneToUpd)) . sel1,
                      uReturning = rReturning id
                    }
              maybe (throwError $ Err 1 "insert failure") (return . rep . uncurryN SceneGet) (listToMaybe ru)
          )
          -<
            sceneToUpd
      respondA ok200 JSON -< (ru :: Rep SceneGet)

sceneDel ::
  ( StdHandler h App,
    HaveTraits '[PathVar "id" Int64] ts,
    Sets h [RequiredResponseHeader "Content-Type" Text, Body JSON (Rep Text), Body JSON (Rep ())]
  ) =>
  RequestHandler h ts
sceneDel =
  proc request -> do
    let tid = pick @(PathVar "id" Int64) $ from request
    r <-
      arrM
        ( \tid -> do
            pool <- asks (^. appEnvPool)
            c <- liftIO . withResource pool $
              \conn ->
                runDelete conn $
                  Delete
                    { dTable = sceneTable,
                      dWhere = (.== sqlInt8 tid) . sel1,
                      dReturning = rCount
                    }
            pure $ if c == 1 then repOk else repErr 1 "delete failure"
        )
        -<
          tid
    respondA ok200 JSON -< (r :: Rep Text)

actorList ::
  ( StdHandler h App,
    Gets h '[Body JSON Page],
    Sets h [RequiredResponseHeader "Content-Type" Text, Body JSON (Rep (PageD [Actor])), Body JSON (Rep ())]
  ) =>
  RequestHandler h ts
actorList =
  requestBody @Page JSON errorHandler $
    proc request -> do
      let page = pick @(Body JSON Page) $ from request
      pageD <-
        arrM
          ( \page -> catchRep $ do
              pool <- asks (^. appEnvPool)
              (rs, cs) <- liftIO . withResource pool $
                \conn -> do
                  rs <- runSelect conn . limit (fromIntegral $ page ^. pageSize) . offset (fromIntegral $ (page ^. pageIndex - 1) * (page ^. pageSize)) $ selectTable actorTable
                  cs <- runSelect conn . countRows $ selectTable actorTable
                  return (rs, cs)
              return . rep . fillPage page (maybe 0 fromIntegral (listToMaybe (cs :: [Int64]))) $ uncurryN Actor <$> rs
          )
          -<
            page
      respondA ok200 JSON -< pageD

actorGet ::
  ( StdHandler h App,
    HaveTraits '[PathVar "id" Int64] ts,
    Sets h [RequiredResponseHeader "Content-Type" Text, Body JSON (Rep (Maybe Actor))]
  ) =>
  RequestHandler h ts
actorGet =
  proc request -> do
    let tid = pick @(PathVar "id" Int64) $ from request
    (mActor :: Maybe Actor) <-
      arrM
        ( \tid -> do
            pool <- asks (^. appEnvPool)
            rs <- liftIO . withResource pool $
              \conn -> runSelect conn $ do
                r <- selectTable actorTable
                where_ $ sel1 r .== sqlInt8 tid
                pure r
            pure . listToMaybe $ uncurryN Actor <$> rs
        )
        -<
          tid
    respondA ok200 JSON -< rep mActor

actorAdd ::
  ( StdHandler h App,
    Gets h '[Body JSON ActorAdd],
    Sets h [RequiredResponseHeader "Content-Type" Text, Body JSON (Rep Int64), Body JSON (Rep ())]
  ) =>
  RequestHandler h ts
actorAdd =
  requestBody @ActorAdd JSON errorHandler $
    proc request -> do
      let actorToAdd = pick @(Body JSON ActorAdd) $ from request
      tid <-
        arrM
          ( \actorToAdd -> catchRep $ do
              pool <- asks (^. appEnvPool)
              ids <- liftIO . withResource pool $ \conn -> do
                runInsert
                  conn
                  Insert
                    { iTable = actorTable,
                      iRows =
                        [ ( Nothing,
                            sqlInt8 (_actorAddSceneId actorToAdd),
                            sqlStrictText (_actorAddInfo actorToAdd)
                          )
                        ],
                      iReturning = rReturning sel1,
                      iOnConflict = Nothing
                    }
              maybe (throwError $ Err 1 "insert failure") (return . rep) (listToMaybe ids)
          )
          -<
            actorToAdd
      respondA ok200 JSON -< (tid :: Rep Int64)

actorUpd ::
  ( StdHandler h App,
    Gets h '[Body JSON ActorUpd],
    Sets h [RequiredResponseHeader "Content-Type" Text, Body JSON (Rep Actor), Body JSON (Rep ())]
  ) =>
  RequestHandler h ts
actorUpd =
  requestBody @ActorUpd JSON errorHandler $
    proc request -> do
      let actorToUpd = pick @(Body JSON ActorUpd) $ from request
      ru <-
        arrM
          ( \actorToUpd -> catchRep $ do
              pool <- asks (^. appEnvPool)
              ru <- liftIO . withResource pool $ \conn -> do
                runUpdate
                  conn
                  Update
                    { uTable = actorTable,
                      uUpdateWith =
                        updateEasy
                          ( \(id_, sceneId, info) ->
                              ( id_,
                                sceneId,
                                maybe info sqlStrictText (_actorUpdInfo actorToUpd)
                              )
                          ),
                      uWhere = (.== sqlInt8 (_actorUpdId actorToUpd)) . sel1,
                      uReturning = rReturning id
                    }
              maybe (throwError $ Err 1 "insert failure") (return . rep . uncurryN Actor) (listToMaybe ru)
          )
          -<
            actorToUpd
      respondA ok200 JSON -< (ru :: Rep Actor)

actorDel ::
  ( StdHandler h App,
    HaveTraits '[PathVar "id" Int64] ts,
    Sets h [RequiredResponseHeader "Content-Type" Text, Body JSON (Rep Text), Body JSON (Rep ())]
  ) =>
  RequestHandler h ts
actorDel =
  proc request -> do
    let tid = pick @(PathVar "id" Int64) $ from request
    r <-
      arrM
        ( \tid -> do
            pool <- asks (^. appEnvPool)
            c <- liftIO . withResource pool $
              \conn ->
                runDelete conn $
                  Delete
                    { dTable = actorTable,
                      dWhere = (.== sqlInt8 tid) . sel1,
                      dReturning = rCount
                    }
            pure $ if c == 1 then repOk else repErr 1 "delete failure"
        )
        -<
          tid
    respondA ok200 JSON -< (r :: Rep Text)

voterList ::
  ( StdHandler h App,
    Gets h '[Body JSON Page],
    Sets h [RequiredResponseHeader "Content-Type" Text, Body JSON (Rep (PageD [Voter])), Body JSON (Rep ())]
  ) =>
  RequestHandler h ts
voterList =
  requestBody @Page JSON errorHandler $
    proc request -> do
      let page = pick @(Body JSON Page) $ from request
      pageD <-
        arrM
          ( \page -> catchRep $ do
              pool <- asks (^. appEnvPool)
              (rs, cs) <- liftIO . withResource pool $
                \conn -> do
                  rs <- runSelect conn . limit (fromIntegral $ page ^. pageSize) . offset (fromIntegral $ (page ^. pageIndex - 1) * (page ^. pageSize)) $ selectTable voterTable
                  cs <- runSelect conn . countRows $ selectTable voterTable
                  return (rs, cs)
              return . rep . fillPage page (maybe 0 fromIntegral (listToMaybe (cs :: [Int64]))) $ uncurryN Voter <$> rs
          )
          -<
            page
      respondA ok200 JSON -< pageD

voterGet ::
  ( StdHandler h App,
    HaveTraits '[PathVar "id" Int64] ts,
    Sets h [RequiredResponseHeader "Content-Type" Text, Body JSON (Rep (Maybe Voter))]
  ) =>
  RequestHandler h ts
voterGet =
  proc request -> do
    let tid = pick @(PathVar "id" Int64) $ from request
    (mVoter :: Maybe Voter) <-
      arrM
        ( \tid -> do
            pool <- asks (^. appEnvPool)
            rs <- liftIO . withResource pool $
              \conn -> runSelect conn $ do
                r <- selectTable voterTable
                where_ $ sel1 r .== sqlInt8 tid
                pure r
            pure . listToMaybe $ uncurryN Voter <$> rs
        )
        -<
          tid
    respondA ok200 JSON -< rep mVoter

voterAdd ::
  ( StdHandler h App,
    Gets h '[Body JSON VoterAdd],
    Sets h [RequiredResponseHeader "Content-Type" Text, Body JSON (Rep Int64), Body JSON (Rep ())]
  ) =>
  RequestHandler h ts
voterAdd =
  requestBody @VoterAdd JSON errorHandler $
    proc request -> do
      let voterToAdd = pick @(Body JSON VoterAdd) $ from request
      tid <-
        arrM
          ( \voterToAdd -> catchRep $ do
              pool <- asks (^. appEnvPool)
              ms <- do
                ss <- liftIO . withResource pool $ \conn -> runSelect conn $ do
                  r <- selectTable sceneTable
                  where_ $ sel1 r .== sqlInt8 (_voterAddSceneId voterToAdd)
                  pure r
                pure . listToMaybe $ uncurryN SceneGet <$> ss
              sGet <- case ms of
                Just s -> pure s
                _ -> throwError $ Err 1 "cannot get scene info"
              (factorNume, factorDeno) <- case readMaybe . unpack $ _sceneGetType sGet of
                Just SceneTypeMark -> pure (_voterAddFactorNume voterToAdd, _voterAddFactorDeno voterToAdd)
                Just _ -> pure (1, 1)
                Nothing -> throwError $ Err 1 "scene type not exist"
              when (factorNume < 1) . throwError $ Err 1 "factor nume must be greater than zero"
              when (factorDeno < 1) . throwError $ Err 1 "factor deno must be greater than zero"
              ids <- liftIO . withResource pool $ \conn -> do
                runInsert
                  conn
                  Insert
                    { iTable = voterTable,
                      iRows =
                        [ ( Nothing,
                            sqlInt8 (_voterAddSceneId voterToAdd),
                            sqlStrictText (_voterAddInfo voterToAdd),
                            sqlInt4 factorNume,
                            sqlInt4 factorDeno
                          )
                        ],
                      iReturning = rReturning sel1,
                      iOnConflict = Nothing
                    }
              maybe (throwError $ Err 1 "insert failure") (return . rep) (listToMaybe ids)
          )
          -<
            voterToAdd
      respondA ok200 JSON -< (tid :: Rep Int64)

voterUpd ::
  ( StdHandler h App,
    Gets h '[Body JSON VoterUpd],
    Sets h [RequiredResponseHeader "Content-Type" Text, Body JSON (Rep Voter), Body JSON (Rep ())]
  ) =>
  RequestHandler h ts
voterUpd =
  requestBody @VoterUpd JSON errorHandler $
    proc request -> do
      let voterToUpd = pick @(Body JSON VoterUpd) $ from request
      ru <-
        arrM
          ( \voterToUpd -> catchRep $ do
              pool <- asks (^. appEnvPool)
              ru <- liftIO . withResource pool $ \conn -> do
                runUpdate
                  conn
                  Update
                    { uTable = voterTable,
                      uUpdateWith =
                        updateEasy
                          ( \(id_, sceneId, info, factorNume, factorDeno) ->
                              ( id_,
                                sceneId,
                                maybe info sqlStrictText (_voterUpdInfo voterToUpd),
                                factorNume,
                                factorDeno
                              )
                          ),
                      uWhere = (.== sqlInt8 (_voterUpdId voterToUpd)) . sel1,
                      uReturning = rReturning id
                    }
              maybe (throwError $ Err 1 "insert failure") (return . rep . uncurryN Voter) (listToMaybe ru)
          )
          -<
            voterToUpd
      respondA ok200 JSON -< (ru :: Rep Voter)

voterDel ::
  ( StdHandler h App,
    HaveTraits '[PathVar "id" Int64] ts,
    Sets h [RequiredResponseHeader "Content-Type" Text, Body JSON (Rep Text), Body JSON (Rep ())]
  ) =>
  RequestHandler h ts
voterDel =
  proc request -> do
    let tid = pick @(PathVar "id" Int64) $ from request
    r <-
      arrM
        ( \tid -> do
            pool <- asks (^. appEnvPool)
            c <- liftIO . withResource pool $
              \conn ->
                runDelete conn $
                  Delete
                    { dTable = voterTable,
                      dWhere = (.== sqlInt8 tid) . sel1,
                      dReturning = rCount
                    }
            pure $ if c == 1 then repOk else repErr 1 "delete failure"
        )
        -<
          tid
    respondA ok200 JSON -< (r :: Rep Text)

actionAdd ::
  ( StdHandler h App,
    Gets h '[Body JSON ActionAdd],
    Sets h [RequiredResponseHeader "Content-Type" Text, Body JSON (Rep Int64), Body JSON (Rep ())]
  ) =>
  RequestHandler h ts
actionAdd =
  requestBody @ActionAdd JSON errorHandler $
    proc request -> do
      let actionToAdd = pick @(Body JSON ActionAdd) $ from request
      tid <-
        arrM
          ( \actionToAdd -> catchRep $ do
              pool <- asks (^. appEnvPool)
              ms <- do
                ss <- liftIO . withResource pool $ \conn -> runSelect conn $ do
                  r <- selectTable sceneTable
                  where_ $ sel1 r .== sqlInt8 (_actionAddSceneId actionToAdd)
                  pure r
                pure . listToMaybe $ uncurryN SceneGet <$> ss
              sGet <- case ms of
                Just s -> pure s
                _ -> throwError $ Err 1 "cannot get scene info"
              markNume <- case readMaybe . unpack $ _sceneGetType sGet of
                Just SceneTypeMark -> pure (_actionAddMarkNume actionToAdd)
                Just _ -> pure 1
                Nothing -> throwError $ Err 1 "scene type not exist"
              when (markNume < 0 || markNume > _sceneGetMarkDeno sGet) . throwError $ Err 1 "mark nume must be between 0 and mark deno"
              ids <- liftIO . withResource pool $ \conn -> do
                runInsert
                  conn
                  Insert
                    { iTable = actionTable,
                      iRows =
                        [ ( Nothing,
                            sqlInt8 (_actionAddSceneId actionToAdd),
                            sqlInt8 (_actionAddActorId actionToAdd),
                            sqlInt8 (_actionAddVoterId actionToAdd),
                            sqlInt4 markNume
                          )
                        ],
                      iReturning = rReturning sel1,
                      iOnConflict = Nothing
                    }
              maybe (throwError $ Err 1 "insert failure") (return . rep) (listToMaybe ids)
          )
          -<
            actionToAdd
      respondA ok200 JSON -< (tid :: Rep Int64)
